home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 134 / pascal / scrnswap.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-04-17  |  1.5 KB  |  70 lines
  1. {Compile for TOS!}
  2. {$S10}
  3. program scrtest;
  4.  
  5. var
  6.         old,
  7.         screen,
  8.         screensize,
  9.         zero : Long_integer;
  10.         i : integer;
  11.         gorp:char;
  12.  
  13. Function Malloc( size : Long_Integer ): Long_Integer;
  14.   Gemdos($48);
  15.  
  16. Procedure Setscreen( log, phys : Long_Integer; rez:integer );
  17.   Xbios(5);
  18.  
  19. Function Physbase:Long_integer;
  20.   Xbios(2);
  21.  
  22. procedure nothing;
  23. var a,b:integer;
  24. begin
  25.         a := 1;
  26. end;
  27.  
  28. procedure delay;
  29. var i : integer;
  30. begin
  31.         for i:= 1 to 100 do nothing;
  32. end;
  33.  
  34. procedure fill_scrn( addr:long_integer;  s : string );
  35. var i:integer;
  36. begin
  37.    Setscreen( addr, addr, -1 );
  38.    delay; { wait for vertical retrace ... }
  39.    for i := 1 to 25 do
  40.        writeln( s );
  41.    writeln;
  42. end;
  43.  
  44. begin
  45.         zero := 0;
  46.         screensize := 32000;    { make a long containing 32000 }
  47.  
  48.         screensize := screensize + 255;
  49.  
  50.         screen := Malloc( screensize );
  51.  
  52.         screen := (screen+255) & $ffffff00; { chop off lower 8 bits }
  53.  
  54.         old := Physbase;
  55.         if (screen = zero ) then
  56.                 writeln( ' not enough mem ' )
  57.         else begin
  58.           fill_scrn( screen, 'If you can read this then' );
  59.           fill_scrn( old,
  60.             '                          we were successful!  Press return' );
  61.           while not keypress do begin
  62.              Setscreen( screen, screen, -1 );
  63.              delay;
  64.              setscreen( old, old, -1 );
  65.              delay
  66.           end;
  67.           read(gorp);
  68.         end;
  69. end.
  70.